(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ") T) (LISPXPRIN1 (QUOTE 
"18-NOV-72  3:03:36") T) (LISPXTERPRI T))
(LISPXPRINT (QUOTE TOTALVARS) T)
(RPAQQ TOTALVARS ((FNS GETFILEC COLLECT FILEADD UNCOLLECT *MACRO 
*FILEADD FULLEXPANSION CRPX GSETQ Y/N RECOLLECT GSET PUTPROP LF LC
QUIT GETFILE READDIR COUNTDOWN EXPANSION PRINTREC PRINTREC1 !RECORD
FIXMACRO MACRO ANYTWICE CADRLAST CARLIST RECORD RECDO COMPOSE COMPOSE1
COMPOSE2 COMPOSE3 COMPOSE4 ≠CONS ≠REPLACE *FOR +NEXT VARNAME CONDIT
SETIT INITL +PV GONEXTN | +TESTSET NEGATE *IF THENCLAUSE LFSTRING
LISTFILE LISTFILES) (VARS (CURRENTFILE NIL) (NOCOLLECT NIL) (EXTRAFNS
NIL)) (P (SETQ YESFNS USERWORDS)) (ADDVAL PRETTYMACROS ((RECORD (L)
(PROP RECORD L) (P (RECORD (QUOTE L)))) (LMMMAC (L) (COMS * (SUBST
(GETD (QUOTE L)) (QUOTE DEF) (QUOTE ((P (/PUTDQ L DEF) (FIXMACRO (QUOTE
L)))))))) (!RECORD (L) (PROP !RECORD L) (P (!RECORD (QUOTE L)))) (ADDVAL
(VAR VAL) (P (/SET (QUOTE VAR) (UNION (QUOTE VAL) VAR)))) (EDITMAC
(X) (VARS X) (P (EDITE X (QUOTE ((COMS (##))))))) (NEEDS (L) (P (
GETFILEC (QUOTE L)))))) (EDITMAC MACEXPAND) (ADDVAL NOFNS (FOR IF))
(VARS (QUOTEFNS NIL)) (LMMMAC IF) (LMMMAC FOR) (LMMMAC REPLACE) (ADVISE
DEFINE LOAD)))
(DEFINEQ

(GETFILEC
(LAMBDA (FIL) (COND ((LISTP FIL) (MAPC FIL (FUNCTION GETFILEC))) (T
(OR (AND (INFILEP (SETQ FIL (PACK (LIST (NAMEFIELD FIL) ".COM"))))
(GETFILE FIL)) (GETFILE (NAMEFIELD FIL)))))))

(COLLECT
(LAMBDA (FILE) (GETFILE FILE) (/SET (QUOTE CURRENTFILE) FILE) (/SET
(QUOTE NOCOLLECT) NIL) FILE))

(FILEADD
(NLAMBDA (TYPE ITEM) (COND ((ATOM TYPE) (SETQ TYPE (LIST TYPE))))
(*FILEADD TYPE (EVAL ITEM))))

(UNCOLLECT
(LAMBDA NIL (/SET (QUOTE NOCOLLECT) T)))

(*MACRO
(LAMBDA (L) (PROG ((NOCOLLECT T)) (MAPC (SETQ L (DEFINE L)) (FUNCTION
FIXMACRO))) L))

(*FILEADD
(LAMBDA (TYPE ITEM) (OR NOCOLLECT (COND ((OR (EQ (CAR (QUOTE CURRENTFILE))
(QUOTE NOBIND)) (NOT CURRENTFILE)) (/SET (QUOTE EXTRAFNS) (CONS (APPEND
TYPE ITEM) EXTRAFNS))) (T (PROG (TYPEL VARSLIST (CURRENTFILE (GETFILE
CURRENTFILE))) (SETQ VARSLIST (CAR (CADR (GETP CURRENTFILE (QUOTE
FILE))))) (OR (AND (NOT (MEMBER TYPE (QUOTE ((RECORD) (!RECORD) (LMMMAC)))))
(NOT (CDR TYPE)) (SETQ TYPEL (ASSOC (CAR TYPE) VARSLIST))) (PROG1
(SETQ TYPEL TYPE) (/NCONC1 VARSLIST TYPEL))) (/NCONC1 TYPEL ITEM)
(/NCONC1 (GETP CURRENTFILE (QUOTE FILE)) ITEM)))))))

(FULLEXPANSION
(LAMBDA (X) (SETQ X (EXPANSION X)) (COND ((CDR (GETP (CAR X) (QUOTE
CROPS))) (CRPX (CADR X) (GETP (CAR X) (QUOTE CROPS)))) (T X))))

(CRPX
(LAMBDA (DEF XL) (COND ((NOT XL) DEF) (T (CRPX (LIST (SELECTQ (CAR
XL) (A (QUOTE CAR)) (D (QUOTE CDR)) (HELP "CROPS PROP")) DEF) (CDR
XL))))))

(GSETQ
(NLAMBDA (GSETVAR Y) (GSET GSETVAR (EVAL Y))))

(Y/N
(NLAMBDA (DEFAULT) (PROG ((CNT 10) R) LP (COND ((MINUSP (SETQ CNT
(SUB1 CNT))) (PRIN1 "...") (PRIN1 (SETQ R DEFAULT)) (GO GOTIT)) ((NOT
(READP T)) (DISMISS 500) (GO LP))) (SETQ R (PEEKC T)) GOTIT (COND
((EQ R (QUOTE Y)) (PRIN1 "ES
")) (T (PRIN1 "O
"))) (CLEARBUF T T) (LINBUF NIL) (RETURN R))))

(RECOLLECT
(LAMBDA NIL (/SET (QUOTE NOCOLLECT) NIL)))

(GSET
(LAMBDA (X Y) (FILEADD VARS X) (/SET X Y)))

(PUTPROP
(LAMBDA (NAM IND VAL) (*FILEADD (LIST (QUOTE PROP) IND) NAM) (PUT
NAM IND VAL)))

(LF
(LAMBDA (FILES) (MAPC FILES (FUNCTION LOAD))))

(LC
(LAMBDA (FILES) (OR FILES (SETQ FILES (READDIR "*.COM"))) (MAPC FILES
(FUNCTION (LAMBDA (FILE) (LOAD (PACK (LIST FILE ".COM"))))))))

(QUIT
(LAMBDA NIL (MAKEFILES ' (FAST RC)) (LOGOUT)))

(GETFILE
(LAMBDA (FILE) (COND ((LISTP FILE) (MAPCAR FILE (FUNCTION GETFILE)))
((MEMBER FILE FILELST)) ((AND (INFILEP FILE) (PRIN1 
"DO YOU WANT ME TO LOAD ") (PRIN1 FILE) (PRIN1 " ?") (EQ (Y/N N) (QUOTE
Y))) (LOAD FILE)) (T (/PUT FILE (QUOTE FILE) (LIST (/RPLACA (PACK
(LIST FILE "FNS"))) (/RPLACA (PACK (LIST FILE "VARS")) (COPY (QUOTE
((FNS) (VARS))))))) (/SET (QUOTE FILELST) (CONS FILE FILELST)))) FILE))

(READDIR
(LAMBDA (STR) (PROG (FIL RESLT HELPCLOCK (CNT 20)) (TENEX (CONCAT
"DIR " STR " ,
OU D.D;0


")) (INFILE (QUOTE D.D)) (READ (QUOTE D.D)) LP (SETQ FIL (NLSETQ (READ
(QUOTE D.D)))) (COND ((NOT FIL) (RETURN RESLT))) (SETQ FIL (NAMEFIELD
(CAR FIL))) (COND ((NOT FIL) (GO LP))) (PRIN1 FIL) (PRIN1 " ? ") (COND
((EQ (Y/N Y) (QUOTE Y)) (SETQ RESLT (CONS FIL RESLT)))) (GO LP))))

(COUNTDOWN
(LAMBDA (SEXP ALST) (COND ((NULL ALST) NIL) ((LISTP SEXP) (COUNTDOWN
(CDR SEXP) (COUNTDOWN (CAR SEXP) ALST))) (T (PROG (X) (SETQ X (ASSOC
SEXP ALST)) (RETURN (COND ((NULL X) ALST) ((EQP (CDR X) 1) NIL) (T
(RPLACD X (SUB1 (CDR X))) ALST))))))))

(EXPANSION
(LAMBDA (FORM) (PROG ((MACVAL (GETP (CAR FORM) (QUOTE MACRO)))) (COND
((NOT MACVAL) FORM) ((MEMB (CAR MACVAL) (QUOTE (LAMBDA NLAMBDA)))
(CONS MACVAL (CDR FORM))) ((AND (CAR MACVAL) (ATOM (CAR MACVAL)))
(EVALA (CADR MACVAL) (LIST (CONS (CAR MACVAL) (CDR FORM))))) (T (SUBPAIR
(CAR MACVAL) (CDR FORM) (CADR MACVAL)))))))

(PRINTREC
(LAMBDA (REC VAL) (PROG ((NAME REC)) (COND ((OR (LISTP REC) (SETQ
REC (GETP REC (QUOTE RECORD)))) (PRINTREC1 REC VAL)) ((SETQ REC (GETP
NAME (QUOTE !RECORD))) (PRIN1 (CAR VAL)) (PRINT (QUOTE :)) (PRINTREC1
REC (CDR VAL))) (T (PRIN1 NAME) (PRIN1 "?") (PRINT VAL))))))

(PRINTREC1
(LAMBDA (REC VAL) (COND ((NULL REC) NIL) ((ATOM REC) (PRIN1 REC) (PRIN1
" = ") (PRINT VAL)) (T (PRINTREC1 (CAR REC) (CAR VAL)) (PRINTREC1
(CDR REC) (CDR VAL))))))

(!RECORD
(LAMBDA (NAME FIELD) (PROG ((NOCOLLECT T)) (COND (FIELD (/PUT NAME
(QUOTE !RECORD) FIELD)) ((SETQ FIELD (GETP NAME (QUOTE !RECORD))))
(T (ERROR "EMPTY RECORD" NAME))) (*MACRO (LIST (LIST (PACK (LIST NAME
"?")) (LIST (QUOTE LAMBDA) (QUOTE (IDVAR)) (LIST (QUOTE EQ) (QUOTE
(CAR IDVAR)) (KWOTE NAME)))))) (*MACRO (LIST (LIST NAME (SUBST NAME
(QUOTE NAME) (SUBST FIELD (QUOTE FIELD) (QUOTE (NLAMBDA RECORDVAR
(SETQ RECORDVAR (REMOVE (QUOTE IS) (REMOVE (QUOTE =) RECORDVAR)))
(EVAL (COMPOSE RECORDVAR (QUOTE ((ID . NAME) . FIELD))))))))))) (RECDO
FIELD (QUOTE (CDR X)))) (FILEADD !RECORD NAME) NAME))

(FIXMACRO
(LAMBDA (FN) (SELECTQ (FNTYP FN) (EXPR (/PUT FN (QUOTE MACRO) (COND
((ANYTWICE FN (CADR (GETD FN)) (CADDR (GETD FN))) (GETD FN)) (T (CDR
(GETD FN)))))) (FEXPR (AND (EQ (CAAR (LAST (GETD FN))) (QUOTE EVAL))
(/PUT FN (QUOTE MACRO) (LIST (QUOTE L) (CONS (CONS (QUOTE LAMBDA)
(CADRLAST (CDR (GETD FN)))) (CARLIST (CADR (GETD FN)) (QUOTE L)))))))
(EXPR* (OR (ANYTWICE FN NIL (CADDR (GETD FN))) (/PUT FN (QUOTE MACRO)
(GETD FN)))) (FEXPR* (AND (EQ (CAAR (LAST (GETD FN))) (QUOTE EVAL))
(/PUT FN (QUOTE MACRO) (LIST (CADR (GETD FN)) (CONS (QUOTE PROGN)
(CADRLAST (CDDR (GETD FN)))))))) (ERROR FN "FIXMACRO CAN'T"))))

(MACRO
(LAMBDA (L) (MAPCAR (*MACRO L) (FUNCTION (LAMBDA (X) (FILEADD LMMMAC
X))))))

(ANYTWICE
(LAMBDA (FN ARGS SEXP) (NOT (COUNTDOWN SEXP (CONS (CONS FN 1) (MAPCAR
ARGS (FUNCTION (LAMBDA (X) (CONS X 2)))))))))

(CADRLAST
(LAMBDA (L) (COND ((NULL (CDR L)) (LIST (CADAR L))) (T (CONS (CAR
L) (CADRLAST (CDR L)))))))

(CARLIST
(LAMBDA (L DEF) (CONS (LIST (QUOTE CAR) DEF) (AND (CDR L) (CARLIST
(CDR L) (LIST (QUOTE CDR) DEF))))))

(RECORD
(LAMBDA (NAME FIELD) (PROG ((NOCOLLECT T)) (COND (FIELD (/PUT NAME
(QUOTE RECORD) FIELD)) ((SETQ FIELD (GETP NAME (QUOTE RECORD)))) (T
(ERROR "EMPTY RECORD" NAME))) (*MACRO (LIST (LIST NAME (SUBST FIELD
(QUOTE FIELD) (QUOTE (NLAMBDA RECORDVAR (SETQ RECORDVAR (REMOVE (QUOTE
IS) (REMOVE (QUOTE =) RECORDVAR))) (EVAL (COMPOSE RECORDVAR (QUOTE
FIELD))))))))) (RECDO FIELD (QUOTE X))) (FILEADD RECORD NAME) NAME))

(RECDO
(LAMBDA (FORMAT DEF) (COND ((NULL FORMAT) NIL) ((LISTP FORMAT) (RECDO
(CAR FORMAT) (LIST (QUOTE CAR) DEF)) (RECDO (CDR FORMAT) (LIST (QUOTE
CDR) DEF))) (T (MACRO (LIST (LIST FORMAT (SUBST DEF (QUOTE DEF) (QUOTE
(NLAMBDA RECORDFIELDVAR (SETQ RECORDFIELDVAR (REMOVE (QUOTE OF) 
RECORDFIELDVAR)) (EVAL (SUBST (COND ((NULL (CDR RECORDFIELDVAR)) (CAR
RECORDFIELDVAR)) (T RECORDFIELDVAR)) (QUOTE X) (QUOTE DEF)))))))))))))

(COMPOSE
(LAMBDA (L FIELD) (SELECTQ (CAR L) (FROM (COND ((ATOM (CADR L)) (
COMPOSE1 L FIELD (CADR L))) (T (LIST (LIST (QUOTE LAMBDA) (QUOTE (
COMPOSEVAR)) (COMPOSE1 L FIELD (QUOTE COMPOSEVAR))) (CADR L))))) (DFROM
(COND ((ATOM (CADR L)) (COND ((EQ (CADR (SETQ FIELD (COMPOSE1 L FIELD
(CADR L)))) (CADR L)) FIELD) (T (LIST (QUOTE PROGN) FIELD (CADR L)))))
(T (LIST (LIST (QUOTE LAMBDA) (QUOTE (COMPOSEVAR)) (COMPOSE1 L FIELD
(QUOTE COMPOSEVAR)) (QUOTE COMPOSEVAR)) (CADR L))))) (COMPOSE1 L FIELD
(QUOTE COMPOSEVAR)))))

(COMPOSE1
(LAMBDA (L FIELD DEF) (PROG (K) (COND ((SETQ K (COMPOSE2 L FIELD DEF))
(CAR K)) (T (COMPOSE3 L FIELD DEF))))))

(COMPOSE2
(LAMBDA (L FIELD DEF) (COND ((NULL FIELD) NIL) ((ATOM FIELD) (AND
(MEMB FIELD L) (SELECTQ (CAR L) (DFROM (LIST (LIST (SELECTQ (CAR DEF)
(CAR (QUOTE RPLACA)) (QUOTE RPLACD)) (CADR DEF) (SUBST DEF (QUOTE
**) (GET L FIELD))))) (LIST (SUBST DEF (QUOTE **) (GET L FIELD))))))
((EQ (CAR FIELD) (QUOTE ID)) (LIST (KWOTE (CDR FIELD)))) (T (PROG
(KA KD) (SETQ KD (COMPOSE2 L (CDR FIELD) (LIST (QUOTE CDR) DEF)))
(SETQ KA (COMPOSE2 L (CAR FIELD) (LIST (QUOTE CAR) DEF))) (AND (NULL
KA) (NULL KD) (RETURN NIL)) (RETURN (LIST (SELECTQ (CAR L) (DFROM
(≠REPLACE (CAR KA) (CAR KD))) (≠CONS (COND (KA (CAR KA)) (T (COMPOSE1
L (CAR FIELD) (LIST (QUOTE CAR) DEF)))) (COND (KD (CAR KD)) (T (COMPOSE1
L (CDR FIELD) (LIST (QUOTE CDR) DEF)))))))))))))

(COMPOSE3
(LAMBDA (L FIELD DEF) (SELECTQ (CAR L) (FROM DEF) (COMPOSE4 FIELD))))

(COMPOSE4
(LAMBDA (FIELD) (COND ((NULL FIELD) NIL) ((ATOM FIELD) ((LAMBDA (X)
(COND (X (KWOTE X)))) (GETP FIELD (QUOTE RECDEFAULT)))) (T (≠CONS
(COMPOSE4 (CAR FIELD)) (COMPOSE4 (CDR FIELD)))))))

(≠CONS
(LAMBDA (CARPART CDRPART) (COND ((OR (EQ (CAR CDRPART) (QUOTE LIST))
(NOT (CAR CDRPART))) (CONS (QUOTE LIST) (CONS CARPART (CDR CDRPART))))
(T (LIST (QUOTE CONS) CARPART CDRPART)))))

(≠REPLACE
(LAMBDA (CARPART CDRPART) (COND ((NULL CARPART) CDRPART) ((NULL CDRPART)
CARPART) ((AND (EQ (CAR CARPART) (QUOTE RPLACA)) (EQ (CAR CDRPART)
(QUOTE RPLACD)) (EQUAL (CADR CARPART) (CADR CDRPART))) (LIST (QUOTE
RPLACD) CARPART (CADDR CDRPART))) (T (LIST (QUOTE PROGN) CARPART CDRPART))))
)

(*FOR
(LAMBDA (L) (PROG (N FV PV EPILOGUE PROLOGUE DOFORM DOTYPE VAR RANGE
LST VARNEXT NEXT NEXTS N2 N3 INIT TESTSET) (SETQ N 1) FORLOOP (AND
(EQ (CAR L) (QUOTE NEW)) (+PV (CAR (SETQ L (CDR L))))) (SETQ VAR (CAR
L)) (SETQ RANGE (CADDR L)) (+NEXT (SETQ VARNEXT (VARNAME "NEXT")))
(SELECTQ (CADR L) (IN (+TESTSET (CONDIT (NEGATE (INITL (+PV (SETQ
LST (VARNAME "LIST"))) RANGE)) (GONEXTN))) (+TESTSET (SETIT VAR (LIST
(QUOTE CAR) LST))) (+NEXT (SETIT LST (LIST (QUOTE CDR) LST)))) (ON
(+TESTSET (CONDIT (NEGATE VAR) (GONEXTN))) (+NEXT (SETIT (INITL VAR
RANGE) (LIST (QUOTE CDR) VAR)))) (:= (SETQ N2 (COND ((ATOM (CADR RANGE))
(CADR RANGE)) (T (INITL (+PV (VARNAME "MAX")) (CADR RANGE))))) (SETQ
N3 (COND ((CDDR RANGE) (COND ((ATOM (CADDR RANGE)) (CADDR RANGE))
(T (INITL (+PV (VARNAME "INC")) (CADDR RANGE))))) ((AND (NUMBERP (CAR
RANGE)) (NUMBERP (CADR RANGE)) (GREATERP (CAR RANGE) (CADR RANGE)))
-1) (T 1))) (INITL VAR (CAR RANGE)) (+TESTSET (CONDIT (COND ((NOT
(NUMBERP N3)) (LIST (QUOTE COND) (LIST (LIST (QUOTE MINUSP) N3) (LIST
(QUOTE ILESSP) VAR N2)) (LIST T (LIST (QUOTE OR (LIST (QUOTE ZEROP)
N3) (LIST (QUOTE GREATERP) VAR N2)))))) ((MINUSP N3) (LIST (QUOTE
ILESSP) VAR N2)) (T (LIST (QUOTE IGREATERP) VAR N2))) (GONEXTN)))
(+NEXT (SETIT VAR (LIST (QUOTE IPLUS) VAR N3)))) (IS (+TESTSET (SETIT
VAR RANGE))) (ERROR "INVALID FOR TYPE")) (SETQ L (CDDDR L)) ASLOOP
(SELECTQ (CAR L) (AS (SETQ L (CDR L)) (SETQ NEXTS (APPEND NEXTS NEXT))
(SETQ NEXT) (GO FORLOOP)) ((IF WHEN) (+TESTSET (CONDIT (NEGATE (CADR
L)) (LIST (QUOTE GO) VARNEXT))) (SETQ L (CDDR L))) (UNTIL (+NEXT (CONDIT
(CADR L) (GONEXTN))) (SETQ L (CDDR L))) (WHILE (+TESTSET (CONDIT (NEGATE
(CADR L)) (GONEXTN))) (SETQ L (CDDR L))) (GO FORTEST)) (GO ASLOOP)
FORTEST (SETQ PROLOGUE (APPEND TESTSET (LIST (| "LOOP" N)) INIT PROLOGUE))
(SETQ EPILOGUE (CONS (| "NEXT" N) (APPEND (REVERSE NEXT) (REVERSE
NEXTS) (CONS (LIST (QUOTE GO) (| "LOOP" N)) EPILOGUE)))) (SETQ TESTSET
(SETQ INIT (SETQ NEXT (SETQ NEXTS)))) (COND ((EQ (CAR L) (QUOTE FOR))
(SETQ L (CDR L)) (SETQ N (ADD1 N)) (GO FORLOOP))) (SETQ DOTYPE (CAR
L)) (SETQ DOVAL (CAR (LAST L))) (+PV (QUOTE FOR-VALUE)) (SETQ FV (
SELECTQ DOTYPE ((APPEND LIST NCONC) (QUOTE (CAR FOR-VALUE))) (QUOTE
FOR-VALUE))) (SETQ DOFORM (SELECTQ DOTYPE ((AND OR) (CONDIT (LIST
(SELECTQ DOTYPE (AND (INITL (QUOTE FOR-VALUE) T) (QUOTE NOT)) (QUOTE
PROGN)) (SETIT (QUOTE FOR-VALUE) DOVAL)) (QUOTE (RETURN FOR-VALUE))))
((PROGN PROG2) (SETIT (QUOTE FOR-VALUE) DOVAL)) (DO DOVAL) (SETIT
(QUOTE FOR-VALUE) (CONS (OR (CDR (ASSOC DOTYPE (QUOTE ((LIST . TCONC)
(NCONC . LCONC) (XLIST . CONS) (APPEND . LCONC))))) DOTYPE) (SELECTQ
DOTYPE ((LIST NCONC) (LIST (QUOTE FOR-VALUE) DOVAL)) (APPEND (LIST
'FOR-VALUE (LIST 'APPEND DOVAL))) (LIST DOVAL (QUOTE FOR-VALUE)))))))
(COND ((EQ (CAR (SETQ L (CDR L))) (QUOTE FIRST)) (INITL (QUOTE FOR-VALUE)
(SELECTQ DOTYPE ((LIST APPEND NCONC) (COND ((NLISTP (CADR L)) (LIST
(QUOTE (LAMBDA (FOR% INIT) (CONS FOR% INIT (LAST FOR% INIT)))) (CADR
L))) (T (CONS (CADR L) (LAST (CADR L)))))) (CADR L))) (SETQ L (CDDR
L))) ((MEMB DOTYPE (QUOTE (PLUS IPLUS TIMES ITIMES MAX MIN))) (INITL
(QUOTE FOR-VALUE) (CDR (ASSOC DOTYPE (QUOTE ((PLUS . 0) (MAX . -99999)
(MIN . 99999) (IPLUS . 0) (TIMES . 1) (ITIMES . 1)))))))) (RETURN
(CONS (QUOTE PROG) (CONS PV (APPEND INIT (REVERSE PROLOGUE) (REVERSE
(CDR (REVERSE L))) (LIST DOFORM) EPILOGUE (LIST (QUOTE RETURN) (LIST
(QUOTE RETURN) FV)))))))))

(+NEXT
(LAMBDA (ITEM) (SETQ NEXT (CONS ITEM NEXT)) ITEM))

(VARNAME
(LAMBDA (STR) (PACK (LIST STR "*" VAR))))

(CONDIT
(LAMBDA (PRD DO) (LIST (QUOTE COND) (LIST PRD DO))))

(SETIT
(LAMBDA (VAR VAL) (AND (NOT (EQ VAR VAL)) (LIST (QUOTE SETQ) VAR VAL))))

(INITL
(LAMBDA (VAR VAL) (SETQ INIT (CONS (SETIT VAR VAL) INIT)) VAR))

(+PV
(LAMBDA (VAR) (SETQ PV (CONS VAR PV)) VAR))

(GONEXTN
(LAMBDA NIL (LIST (QUOTE GO) (COND ((EQP N 1) (QUOTE RETURN)) (T (PACK
(LIST "NEXT*" (SUB1 N))))))))

(|
(LAMBDA (STR VAL) (PACK (LIST STR "*" N))))

(+TESTSET
(LAMBDA (ITEM) (SETQ TESTSET (CONS ITEM TESTSET)) ITEM))

(NEGATE
(LAMBDA (EXP) (SELECTQ (CAR EXP) ((NOT NULL) (CADR EXP)) (LIST (QUOTE
NOT) EXP))))

(*IF
(LAMBDA (L) (AND L (CONS (CONS (CAR L) (COND ((NOT (EQ (CADR L) (QUOTE
THEN))) (ERROR L "NO CORRESPONDING THEN IN IF")) (T (SETQ L (CDDR
L)) (THENCLAUSE)))) (COND ((NULL L) NIL) ((EQ (CAR L) (QUOTE ELSEIF))
(*IF (CDR L))) ((EQ (CAR (SETQ L (CDR L))) (QUOTE IF)) (*IF (CDR L)))
(T (LIST (CONS T (THENCLAUSE)))))))))

(THENCLAUSE
(LAMBDA NIL (COND ((OR (NULL L) (MEMB (CAR L) (QUOTE (ELSE ELSEIF))))
(LIST NIL)) ((OR (NOT (CDR L)) (MEMB (CADR L) (QUOTE (ELSE ELSEIF))))
(PROG1 (LIST (CAR L)) (SETQ L (CDR L)))) (T (CONS (CAR L) (PROGN (SETQ
L (CDR L)) (THENCLAUSE)))))))

(LFSTRING
(LAMBDA (FIL) (CONCAT "FTP
" "HOST USC-ISI
" "LOG MASINER DENDRAL 1" "
TENEX
STOR " FIL "
" FIL "

QUIT
QUIT
")))

(LISTFILE
(LAMBDA (FIL) (BKSYSBUF (LFSTRING (NAMEFIELD FIL))) (SUBSYS)))

(LISTFILES
(LAMBDA (FL) (COND ((NOT FL) (SETQ FL NOTLISTEDFILES))) (COND ((ATOM
FL) (SETQ FL (LIST FL)))) (MAPC FL (FUNCTION (LAMBDA (FIL) (LISTFILE
FIL) (SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD FIL) NOTLISTEDFILES)))))))
)
(RPAQ CURRENTFILE NIL)
(RPAQ NOCOLLECT NIL)
(RPAQ EXTRAFNS NIL)
(SETQ YESFNS USERWORDS)
(/SET (QUOTE PRETTYMACROS) (UNION (QUOTE ((RECORD (L) (PROP RECORD
L) (P (RECORD (QUOTE L)))) (LMMMAC (L) (COMS * (SUBST (GETD (QUOTE
L)) (QUOTE DEF) (QUOTE ((P (/PUTDQ L DEF) (FIXMACRO (QUOTE L))))))))
(!RECORD (L) (PROP !RECORD L) (P (!RECORD (QUOTE L)))) (ADDVAL (VAR
VAL) (P (/SET (QUOTE VAR) (UNION (QUOTE VAL) VAR)))) (EDITMAC (X)
(VARS X) (P (EDITE X (QUOTE ((COMS (##))))))) (NEEDS (L) (P (GETFILEC
(QUOTE L)))))) PRETTYMACROS))
(RPAQQ MACEXPAND (M MACEXPAND (IF (GETP (## 1) (QUOTE MACRO)) ((I
: (EXPANSION (##)))))))
(EDITE MACEXPAND (QUOTE ((COMS (##)))))
(/SET (QUOTE NOFNS) (UNION (QUOTE (FOR IF)) NOFNS))
(RPAQ QUOTEFNS NIL)
(/PUTDQ IF (NLAMBDA IF-EXPRESSION (BREAK1 (PROGN (EVAL (CONS (QUOTE
COND) (*IF IF-EXPRESSION)))) T IF NIL)))
(FIXMACRO (QUOTE IF))
(/PUTDQ FOR (NLAMBDA FOR-EXPRESSION (BREAK1 (PROGN (EVAL (*FOR 
FOR-EXPRESSION))) T FOR NIL)))
(FIXMACRO (QUOTE FOR))
(/PUTDQ REPLACE (NLAMBDA (REPLACE1 REPLACE2) (SETQ REPLACE1 (
FULLEXPANSION REPLACE1)) (EVAL (LIST (SELECTQ (CAR REPLACE1) (CAR
(QUOTE RPLACA)) (CDR (QUOTE RPLACD)) (HELP "REPLACE CAN'T" (LIST 
REPLACE1 REPLACE2))) (CADR REPLACE1) REPLACE2))))
(FIXMACRO (QUOTE REPLACE))
(DEFLIST(QUOTE(
(DEFINE (NIL (AFTER NIL (MAPC !VALUE (FUNCTION (LAMBDA (FN) (FILEADD
FNS FN)))))))
(LOAD (NIL (BIND NIL ((NOCOLLECT T)))))
))(QUOTE READVICE))

(READVISE DEFINE LOAD)
STOP